## used (Mb) gc trigger (Mb) limit (Mb) max used (Mb)
## Ncells 532590 28.5 1186980 63.4 NA 669411 35.8
## Vcells 989516 7.6 8388608 64.0 131072 1851571 14.2
Here we the ABCD release 4.0 data-set
The following libraries and default settings were used during the analysis:
Changes: psychopathology to mental health
options(scipen = 999)
#library("sva")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library("tidymodels")
## ── Attaching packages ────────────────────────────────────── tidymodels 1.1.0 ──
## ✔ broom 1.0.5 ✔ rsample 1.1.1
## ✔ dials 1.2.0 ✔ tune 1.1.1
## ✔ infer 1.0.4 ✔ workflows 1.1.3
## ✔ modeldata 1.2.0 ✔ workflowsets 1.0.1
## ✔ parsnip 1.1.0 ✔ yardstick 1.2.0
## ✔ recipes 1.0.7
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/
##parallel map
library(partR2)
##
## Attaching package: 'partR2'
##
## The following object is masked from 'package:modeldata':
##
## biomass
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(yhat)
library(ggtext)
library(ggpubr)
library(cowplot)
##
## Attaching package: 'cowplot'
##
## The following object is masked from 'package:ggpubr':
##
## get_legend
##
## The following object is masked from 'package:lubridate':
##
## stamp
library(partR2)
library(lme4)
library(yhat)
library("VennDiagram")
## Loading required package: grid
## Loading required package: futile.logger
##
## Attaching package: 'VennDiagram'
##
## The following object is masked from 'package:ggpubr':
##
## rotate
library(viridis)
## Loading required package: viridisLite
##
## Attaching package: 'viridis'
##
## The following object is masked from 'package:scales':
##
## viridis_pal
library(ggpointdensity)
library(ggthemes)
##
## Attaching package: 'ggthemes'
##
## The following object is masked from 'package:cowplot':
##
## theme_map
theme_set(theme_bw() + theme(panel.grid = element_blank()))
## parallel processing number of cores register
all_cores <- parallel::detectCores(logical = FALSE) - 5
doParallel::registerDoParallel(cores = all_cores)
We first loaded all of the relevant data files (not shown here as they refer to local directories):
rf_baseline <- readRDS(paste0(scriptfold,"stacking_gfactor_modelling/collect_random_forest_results/random_forest_baseline_results.RDS"))
rf_followup <- readRDS(paste0(scriptfold,"stacking_gfactor_modelling/collect_random_forest_results/random_forest_followup_results.RDS"))
psy_pred <- readRDS(paste0(scriptfold,"Common_psy_gene_brain_all/saved_outputs/psychopathology_pls_pred_2.0.RData"))
gfactor_list <- readRDS(paste0(scriptfold,"genetics_psychopathology_common_scan_all_scripts/gfactor_scale_seperate.RData"))
load in genetics related to cognition predicted results
genetics_cog <- readRDS(paste0(scriptfold,'genetics_psychopathology_common_scan_all_scripts/psychopathology_cog_gene_pred_residual', '.RData'))
gfactor_ses <- readRDS(paste0(scriptfold,'genetics_psychopathology_common_scan_all_scripts/ses_pls_pred', '.RData'))
Be careful with what site you choose.
Extract the needed data sets from the list.
rf_baseline_pred <- map(rf_baseline,"test_pred")
rf_baseline_pred_tibble <- map(rf_baseline_pred,"model_predict")
rf_baseline_table <- map(rf_baseline,"test_data")
rf_followup_pred <- map(rf_followup,"test_pred")
rf_followup_pred_tibble <- map(rf_followup_pred,"model_predict")
rf_followup_table <- map(rf_followup,"test_data")
gfactor_baselie_test <- map(gfactor_list,"output_test_baseline")
gfactor_followup_test <- map(gfactor_list,"output_test_followup")
subj_info <- c("SUBJECTKEY","SITE_ID_L","EVENTNAME")
## this function extract the subject information and join those information to the predicted results
pred_processing <- function(baseline_pred, followup_pred, baseline_table, followup_table,pred_name){
names_vec <- c(subj_info,pred_name)
baseline_subj_info <- baseline_table %>% select(all_of(subj_info))
baseline_pred_vec <- baseline_pred %>% select(model_predict)
baseline_output <- bind_cols(baseline_subj_info,baseline_pred_vec)
names(baseline_output) <- names_vec
followup_subj_info <- followup_table %>% select(all_of(subj_info))
followup_pred_vec <- followup_pred %>% select(model_predict)
followup_output <- bind_cols(followup_subj_info,followup_pred_vec)
names(followup_output) <- names_vec
output_all <- bind_rows(baseline_output,followup_output)
return(list(baseline_output = baseline_output,
followup_output = followup_output))
}
processed_rf_results <- pmap(list(rf_baseline_pred_tibble,rf_baseline_table,
rf_followup_pred_tibble,rf_followup_table),
~pred_processing(baseline_pred=..1,
followup_pred=..3,
baseline_table=..2,
followup_table=..4,
pred_name="random_forest_stacking"))
processed_psy_results <- pmap(list(psy_pred[["baseline_test_pred"]],
psy_pred[["baseline_test_data"]],
psy_pred[["followup_test_pred"]],
psy_pred[["followup_test_data"]]),
~pred_processing(baseline_pred=..1,
followup_pred=..3,
baseline_table=..2,
followup_table=..4,
pred_name="psychopathology"))
site_char <- names(processed_psy_results)
genetics_cog_baseline_pred <-genetics_cog[["baseline_test_pred"]]
genetics_cog_baseline_table <-genetics_cog[["baseline_test_data"]]
genetics_cog_followup_pred <- genetics_cog[["followup_test_pred"]]
genetics_cog_followup_data <- genetics_cog[["followup_test_data"]]
pred_processing_gene <- function(baseline_pred, followup_pred, baseline_table, followup_table,pred_name){
names_vec <- c(c("SUBJECTKEY","SITE_ID_L"),pred_name)
baseline_subj_info <- baseline_table %>% select(all_of(c("SUBJECTKEY","SITE_ID_L")))
baseline_pred_vec <- baseline_pred %>% select(model_predict)
baseline_output <- bind_cols(baseline_subj_info,baseline_pred_vec)
names(baseline_output) <- names_vec
followup_subj_info <- followup_table %>% select(all_of(c("SUBJECTKEY","SITE_ID_L")))
followup_pred_vec <- followup_pred %>% select(model_predict)
followup_output <- bind_cols(followup_subj_info,followup_pred_vec)
names(followup_output) <- names_vec
output_all <- bind_rows(baseline_output,followup_output)
return(list(baseline_output = baseline_output,
followup_output = followup_output))
}
processed_gene_results <- pmap(list(genetics_cog_baseline_pred,genetics_cog_baseline_table,
genetics_cog_followup_pred,genetics_cog_followup_data),
~pred_processing_gene(baseline_pred=..1,
followup_pred=..3,
baseline_table=..2,
followup_table=..4,
pred_name="gene_cog"))
gfactor_ses_baseline_pred <-gfactor_ses[["baseline_test_pred"]]
gfactor_ses_baseline_table <-gfactor_ses[["baseline_test_data"]]
gfactor_ses_followup_pred <- gfactor_ses[["followup_test_pred"]]
gfactor_ses_followup_data <- gfactor_ses[["followup_test_data"]]
processed_ses_results <- pmap(list(gfactor_ses_baseline_pred,gfactor_ses_baseline_table,
gfactor_ses_followup_pred,gfactor_ses_followup_data),
~pred_processing_gene(baseline_pred=..1,
followup_pred=..3,
baseline_table=..2,
followup_table=..4,
pred_name="ses"))
join_pred_gfactor <- function(data_input, site_input){
data_baseline_tibble <- data_input[[site_input]][["baseline_output"]]
data_followup_tibble <- data_input[[site_input]][["followup_output"]]
gfactor_baseline <- gfactor_baselie_test[[site_input]]
gfactor_followup <- gfactor_followup_test[[site_input]]
output_baseline <- plyr::join_all(list(data_baseline_tibble,gfactor_baseline),by="SUBJECTKEY",type = "full")%>%
drop_na()
output_followup <- plyr::join_all(list(data_followup_tibble,gfactor_followup),by="SUBJECTKEY",type="full")%>%
drop_na()
output_all <- bind_rows(output_baseline,output_followup)
return(list(baseline = output_baseline,
followup=output_followup,
all = output_all))
}
Features: stacking brain models, mental health, genes and Soc-Dem-Life-Dev are joined with response variable individually,
gfactor_rf <- map(.x = site_char,~join_pred_gfactor(data_input =processed_rf_results, site_input = .x))
names(gfactor_rf) <- site_char
gfactor_rf_baseline <- map(gfactor_rf,"baseline")%>% do.call(rbind,.)
gfactor_rf_followup <- map(gfactor_rf,"followup")%>% do.call(rbind,.)
gfactor_rf_baseline_followup <- map(gfactor_rf,"all")%>% do.call(rbind,.)
gfactor_psy <- map(.x = site_char,~join_pred_gfactor(data_input =processed_psy_results, site_input = .x))
names(gfactor_psy) <- site_char
gfactor_psy_baseline <- map(gfactor_psy,"baseline")%>% do.call(rbind,.)
gfactor_psy_followup <- map(gfactor_psy,"followup")%>% do.call(rbind,.)
gfactor_psy_baseline_followup <- map(gfactor_psy,"all")%>% do.call(rbind,.)
gfactor_gene <- map(.x = site_char,~join_pred_gfactor(data_input =processed_gene_results, site_input = .x))
names(gfactor_gene) <- site_char
gfactor_gene_baseline <- map(gfactor_gene,"baseline")%>% do.call(rbind,.)%>%
filter(gene_cog < 3)
### try to detect outliers
map(gfactor_gene,"baseline")%>% do.call(rbind,.)%>%
filter(gene_cog > 3)%>%
print()
## [1] SUBJECTKEY SITE_ID_L gene_cog gfactor
## <0 rows> (or 0-length row.names)
gfactor_gene_followup <- map(gfactor_gene,"followup")%>% do.call(rbind,.)%>%
filter(gene_cog < 3)
gfactor_gene_baseline_followup <- map(gfactor_gene,"all")%>% do.call(rbind,.)%>%
filter(gene_cog < 3)
gfactor_ses <- map(.x = site_char,~join_pred_gfactor(data_input =processed_ses_results, site_input = .x))
names(gfactor_ses) <- site_char
gfactor_ses_baseline <- map(gfactor_ses,"baseline")%>% do.call(rbind,.)
gfactor_ses_followup <- map(gfactor_ses,"followup")%>% do.call(rbind,.)
gfactor_ses_baseline_followup <- map(gfactor_ses,"all")%>% do.call(rbind,.)
pred_gfactor_baseline <- list(rf = gfactor_rf_baseline,
psy = gfactor_psy_baseline,
gene = gfactor_gene_baseline,
ses =gfactor_ses_baseline)
pred_gfactor_followup <- list(rf = gfactor_rf_followup,
psy = gfactor_psy_followup,
gene = gfactor_gene_followup,
ses =gfactor_ses_followup)
Load the data input of the performance metrics
brain_performance_metric <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/brain_performance_metric', '.RData'))
gene_performance_metric <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/gene_performance_metric', '.RData'))
mental_health_performance_metric <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/mental_health_performance_metric', '.RData'))
ses_performance_metric <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/ses_performance_metric', '.RData'))
set_of_brain_features_performance_metric <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/set_of_brain_features_performance_metric', '.RData'))
brain_performance_metric_baseline <- brain_performance_metric %>%
filter(event == "baseline")%>%
select(-event)
features_reorder_vec <- c("modality","correlation (sd)", "tradrsq (sd)", "MAE (sd)","RMSE (sd)")
new_names_vec <- c("Features","Correlation", "Traditional R-squared", "MAE","RMSE" )
brain_performance_metric_baseline<- brain_performance_metric_baseline[,features_reorder_vec]
names(brain_performance_metric_baseline) <-new_names_vec
brain_performance_metric_followup<- brain_performance_metric %>%
filter(event == "followup")%>%
select(-event)
brain_performance_metric_followup<- brain_performance_metric_followup[,features_reorder_vec]
names(brain_performance_metric_followup) <-new_names_vec
gene_performance_metric_baseline <- gene_performance_metric%>%
filter(event == "baseline")%>%
select(-event)
gene_performance_metric_baseline<- gene_performance_metric_baseline[,features_reorder_vec]
names(gene_performance_metric_baseline) <-new_names_vec
gene_performance_metric_followup <- gene_performance_metric%>%
filter(event == "followup")%>%
select(-event)
gene_performance_metric_followup<- gene_performance_metric_followup[,features_reorder_vec]
names(gene_performance_metric_followup) <-new_names_vec
mental_health_performance_metric_baseline <- mental_health_performance_metric%>%
filter(event == "baseline")%>%
select(-event)
mental_health_performance_metric_baseline<- mental_health_performance_metric_baseline[,features_reorder_vec]
names(mental_health_performance_metric_baseline) <-new_names_vec
mental_health_performance_metric_followup <- mental_health_performance_metric%>%
filter(event == "followup")%>%
select(-event)
mental_health_performance_metric_followup<- mental_health_performance_metric_followup[,features_reorder_vec]
names(mental_health_performance_metric_followup) <-new_names_vec
ses_performance_metric_baseline <- ses_performance_metric%>%
filter(event == "baseline")%>%
select(-event)
ses_performance_metric_baseline<- ses_performance_metric_baseline[,features_reorder_vec]
names(ses_performance_metric_baseline) <-new_names_vec
ses_performance_metric_followup <- ses_performance_metric%>%
filter(event == "followup")%>%
select(-event)
ses_performance_metric_followup<- ses_performance_metric_followup[,features_reorder_vec]
names(ses_performance_metric_followup) <-new_names_vec
set_of_brain_features_performance_metric_baseline <- set_of_brain_features_performance_metric%>%
filter(event == "baseline")%>%
select(-event)
set_of_brain_features_performance_metric_baseline<- set_of_brain_features_performance_metric_baseline[,features_reorder_vec]
names(set_of_brain_features_performance_metric_baseline) <-new_names_vec
set_of_brain_features_performance_metric_followup <- set_of_brain_features_performance_metric%>%
filter(event == "followup")%>%
select(-event)
set_of_brain_features_performance_metric_followup<- set_of_brain_features_performance_metric_followup[,features_reorder_vec]
names(set_of_brain_features_performance_metric_followup) <-new_names_vec
brain_baseline_table <- bind_rows(brain_performance_metric_baseline,
set_of_brain_features_performance_metric_baseline)
brain_baseline_kable <- brain_baseline_table%>%
kableExtra::kbl(caption = paste0("Performance metrics for brain features, averaged across sites with SD in parentheses in baseline")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
brain_baseline_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Brain | 0.547 (0.065) | 0.3 (0.072) | 0.655 (0.036) | 0.834 (0.046) |
| ENback 2back vs 0back | 0.396 (0.053) | 0.151 (0.048) | 0.662 (0.036) | 0.841 (0.045) |
| ENback 2back | 0.367 (0.063) | 0.129 (0.051) | 0.668 (0.034) | 0.85 (0.041) |
| rsfMRI temporal variance | 0.305 (0.09) | 0.094 (0.053) | 0.733 (0.036) | 0.931 (0.04) |
| rsfMRI cortical FC | 0.301 (0.056) | 0.089 (0.035) | 0.733 (0.026) | 0.928 (0.032) |
| ENback emotion | 0.276 (0.066) | 0.07 (0.043) | 0.691 (0.029) | 0.879 (0.033) |
| cortical thickness | 0.266 (0.098) | 0.073 (0.054) | 0.756 (0.026) | 0.96 (0.029) |
| rsfMRI subcortical-network FC | 0.265 (0.079) | 0.07 (0.042) | 0.741 (0.031) | 0.938 (0.033) |
| T2 gray matter avg intensity | 0.264 (0.105) | 0.07 (0.064) | 0.751 (0.033) | 0.952 (0.036) |
| ENback 0back | 0.264 (0.063) | 0.063 (0.041) | 0.689 (0.029) | 0.88 (0.033) |
| T1 gray matter avg intensity | 0.264 (0.102) | 0.065 (0.071) | 0.76 (0.032) | 0.964 (0.039) |
| T1 white matter avg intensity | 0.262 (0.101) | 0.068 (0.062) | 0.759 (0.027) | 0.963 (0.034) |
| T2 white matter avg intensity | 0.241 (0.104) | 0.058 (0.056) | 0.755 (0.031) | 0.959 (0.032) |
| ENback place | 0.238 (0.069) | 0.049 (0.042) | 0.696 (0.03) | 0.887 (0.036) |
| T2 normalised intensity | 0.236 (0.081) | 0.057 (0.041) | 0.754 (0.021) | 0.958 (0.025) |
| DTI | 0.23 (0.077) | 0.044 (0.05) | 0.761 (0.027) | 0.966 (0.029) |
| cortical volume | 0.229 (0.093) | 0.053 (0.044) | 0.766 (0.021) | 0.971 (0.024) |
| MID Reward vs Neutral anticipation | 0.227 (0.069) | 0.049 (0.034) | 0.74 (0.019) | 0.939 (0.024) |
| MID Large Reward vs Neutral anticipation | 0.219 (0.071) | 0.045 (0.035) | 0.743 (0.02) | 0.942 (0.026) |
| cortical area | 0.218 (0.096) | 0.049 (0.044) | 0.768 (0.021) | 0.973 (0.025) |
| T1 normalised intensity | 0.214 (0.107) | 0.046 (0.047) | 0.769 (0.022) | 0.974 (0.027) |
| MID Positive vs Negative Punishment Feedback | 0.208 (0.061) | 0.04 (0.025) | 0.744 (0.019) | 0.944 (0.026) |
| MID Small Reward vs Neutral anticipation | 0.206 (0.056) | 0.04 (0.025) | 0.745 (0.015) | 0.942 (0.02) |
| MID Loss vs Neutral anticipation | 0.203 (0.064) | 0.038 (0.028) | 0.746 (0.02) | 0.945 (0.024) |
| T1 subcortical avg intensity | 0.199 (0.088) | 0.036 (0.043) | 0.772 (0.022) | 0.978 (0.025) |
| T1 summations | 0.198 (0.078) | 0.01 (0.058) | 0.783 (0.029) | 0.991 (0.034) |
| MID Positive vs Negative Reward Feedback | 0.197 (0.047) | 0.036 (0.018) | 0.746 (0.019) | 0.944 (0.025) |
| MID Small Loss vs Neutral anticipation | 0.187 (0.07) | 0.033 (0.026) | 0.747 (0.021) | 0.948 (0.024) |
| MID Large Loss vs Neutral anticipation | 0.186 (0.061) | 0.031 (0.026) | 0.748 (0.021) | 0.947 (0.025) |
| sulcal depth | 0.182 (0.095) | 0.033 (0.039) | 0.776 (0.02) | 0.983 (0.026) |
| subcortical volume | 0.171 (0.075) | 0.028 (0.028) | 0.774 (0.017) | 0.982 (0.02) |
| T2 subcortical avg intensity | 0.159 (0.056) | 0.024 (0.022) | 0.77 (0.016) | 0.976 (0.016) |
| SST Any Stop vs Correct Go | 0.158 (0.07) | 0.02 (0.027) | 0.733 (0.035) | 0.931 (0.04) |
| SST Correct Go vs Fixation | 0.151 (0.064) | 0.018 (0.021) | 0.737 (0.031) | 0.932 (0.035) |
| ENback Face vs Place | 0.145 (0.072) | 0.014 (0.024) | 0.714 (0.026) | 0.907 (0.033) |
| SST Incorrect Stop vs Correct Go | 0.144 (0.06) | 0.016 (0.02) | 0.735 (0.033) | 0.933 (0.038) |
| MID Large Reward vs Small Reward anticipation | 0.136 (0.054) | 0.017 (0.015) | 0.757 (0.02) | 0.956 (0.025) |
| SST Correct Stop vs Correct Go | 0.129 (0.056) | 0.012 (0.017) | 0.737 (0.032) | 0.933 (0.036) |
| T2 summations | 0.116 (0.051) | 0.008 (0.022) | 0.776 (0.017) | 0.983 (0.015) |
| SST Incorrect Go vs Correct Go | 0.103 (0.054) | 0.007 (0.013) | 0.741 (0.032) | 0.936 (0.035) |
| MID Large Loss vs Small Loss anticipation | 0.089 (0.058) | 0.006 (0.01) | 0.757 (0.024) | 0.959 (0.028) |
| SST Correct Stop vs Incorrect Stop | 0.086 (0.068) | 0.002 (0.018) | 0.741 (0.031) | 0.939 (0.035) |
| SST Incorrect Go vs Incorrect Stop | 0.057 (0.048) | -0.001 (0.009) | 0.743 (0.028) | 0.94 (0.032) |
| ENback Emotion vs Neutral Face | 0.039 (0.064) | -0.005 (0.011) | 0.718 (0.024) | 0.911 (0.032) |
| ENback Positive vs Neutral Face | 0.037 (0.063) | -0.006 (0.012) | 0.717 (0.026) | 0.911 (0.035) |
| ENback Negative vs Neutral Face | 0.013 (0.065) | -0.006 (0.01) | 0.72 (0.023) | 0.914 (0.03) |
brain_followup_table <- bind_rows(brain_performance_metric_followup,
set_of_brain_features_performance_metric_followup)
brain_followup_kable <- brain_followup_table%>%
kableExtra::kbl(caption = paste0("Performance metrics for brain features, averaged across sites with SD in parentheses in followup")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
brain_followup_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Brain | 0.534 (0.077) | 0.275 (0.09) | 0.64 (0.037) | 0.811 (0.053) |
| ENback 2back vs 0back | 0.401 (0.088) | 0.15 (0.074) | 0.665 (0.038) | 0.839 (0.052) |
| ENback 2back | 0.386 (0.076) | 0.138 (0.068) | 0.673 (0.04) | 0.845 (0.053) |
| ENback emotion | 0.307 (0.063) | 0.082 (0.045) | 0.693 (0.042) | 0.874 (0.053) |
| ENback place | 0.305 (0.067) | 0.082 (0.048) | 0.694 (0.041) | 0.873 (0.054) |
| rsfMRI cortical FC | 0.304 (0.089) | 0.077 (0.068) | 0.716 (0.042) | 0.906 (0.052) |
| rsfMRI temporal variance | 0.299 (0.104) | 0.076 (0.066) | 0.719 (0.05) | 0.906 (0.059) |
| ENback 0back | 0.283 (0.068) | 0.069 (0.049) | 0.698 (0.048) | 0.881 (0.057) |
| cortical thickness | 0.259 (0.098) | 0.053 (0.055) | 0.734 (0.036) | 0.927 (0.044) |
| rsfMRI subcortical-network FC | 0.254 (0.09) | 0.051 (0.06) | 0.728 (0.046) | 0.919 (0.054) |
| T1 gray matter avg intensity | 0.245 (0.101) | 0.042 (0.065) | 0.736 (0.041) | 0.932 (0.047) |
| T1 white matter avg intensity | 0.243 (0.085) | 0.043 (0.053) | 0.736 (0.038) | 0.931 (0.043) |
| cortical volume | 0.243 (0.082) | 0.045 (0.042) | 0.74 (0.037) | 0.932 (0.041) |
| cortical area | 0.234 (0.088) | 0.04 (0.049) | 0.741 (0.035) | 0.935 (0.042) |
| T2 gray matter avg intensity | 0.228 (0.105) | 0.041 (0.06) | 0.737 (0.042) | 0.932 (0.054) |
| DTI | 0.222 (0.054) | 0.023 (0.043) | 0.742 (0.035) | 0.939 (0.04) |
| T1 summations | 0.214 (0.052) | 0.01 (0.039) | 0.751 (0.034) | 0.948 (0.037) |
| MID Positive vs Negative Punishment Feedback | 0.211 (0.058) | 0.028 (0.033) | 0.737 (0.043) | 0.926 (0.052) |
| T2 white matter avg intensity | 0.206 (0.093) | 0.029 (0.051) | 0.742 (0.041) | 0.938 (0.05) |
| T2 normalised intensity | 0.199 (0.062) | 0.027 (0.031) | 0.744 (0.041) | 0.94 (0.047) |
| T1 subcortical avg intensity | 0.195 (0.096) | 0.004 (0.083) | 0.753 (0.04) | 0.95 (0.047) |
| MID Positive vs Negative Reward Feedback | 0.192 (0.076) | 0.02 (0.045) | 0.735 (0.043) | 0.928 (0.05) |
| sulcal depth | 0.184 (0.089) | 0.017 (0.04) | 0.75 (0.033) | 0.946 (0.04) |
| subcortical volume | 0.182 (0.065) | 0.016 (0.032) | 0.745 (0.038) | 0.943 (0.041) |
| T1 normalised intensity | 0.176 (0.068) | 0.016 (0.032) | 0.748 (0.038) | 0.946 (0.044) |
| ENback Face vs Place | 0.171 (0.063) | 0.017 (0.027) | 0.717 (0.041) | 0.903 (0.048) |
| SST Any Stop vs Correct Go | 0.171 (0.072) | 0.014 (0.039) | 0.733 (0.053) | 0.921 (0.068) |
| MID Large Reward vs Neutral anticipation | 0.166 (0.059) | 0.011 (0.03) | 0.745 (0.041) | 0.936 (0.047) |
| MID Reward vs Neutral anticipation | 0.165 (0.068) | 0.011 (0.034) | 0.743 (0.041) | 0.935 (0.046) |
| SST Incorrect Stop vs Correct Go | 0.161 (0.084) | 0.012 (0.038) | 0.732 (0.053) | 0.922 (0.067) |
| SST Correct Stop vs Correct Go | 0.158 (0.055) | 0.01 (0.028) | 0.733 (0.051) | 0.923 (0.065) |
| T2 subcortical avg intensity | 0.154 (0.077) | 0.008 (0.031) | 0.75 (0.037) | 0.948 (0.04) |
| MID Large Loss vs Neutral anticipation | 0.147 (0.061) | 0.005 (0.028) | 0.743 (0.042) | 0.933 (0.048) |
| SST Correct Go vs Fixation | 0.144 (0.07) | 0.007 (0.029) | 0.734 (0.048) | 0.922 (0.061) |
| MID Loss vs Neutral anticipation | 0.142 (0.064) | 0.006 (0.024) | 0.746 (0.042) | 0.938 (0.047) |
| MID Small Reward vs Neutral anticipation | 0.142 (0.081) | 0.006 (0.034) | 0.744 (0.042) | 0.936 (0.049) |
| T2 summations | 0.124 (0.068) | -0.001 (0.03) | 0.757 (0.042) | 0.954 (0.048) |
| MID Small Loss vs Neutral anticipation | 0.124 (0.08) | 0.001 (0.025) | 0.749 (0.043) | 0.941 (0.05) |
| SST Incorrect Go vs Correct Go | 0.122 (0.063) | 0.002 (0.025) | 0.74 (0.055) | 0.93 (0.067) |
| SST Correct Stop vs Incorrect Stop | 0.101 (0.081) | -0.004 (0.028) | 0.739 (0.049) | 0.93 (0.063) |
| MID Large Loss vs Small Loss anticipation | 0.082 (0.078) | -0.008 (0.021) | 0.751 (0.043) | 0.943 (0.048) |
| MID Large Reward vs Small Reward anticipation | 0.075 (0.049) | -0.008 (0.017) | 0.753 (0.042) | 0.946 (0.048) |
| SST Incorrect Go vs Incorrect Stop | 0.026 (0.068) | -0.015 (0.019) | 0.742 (0.053) | 0.935 (0.066) |
| ENback Positive vs Neutral Face | 0.025 (0.063) | -0.011 (0.014) | 0.725 (0.043) | 0.911 (0.049) |
| ENback Emotion vs Neutral Face | -0.007 (0.058) | -0.012 (0.013) | 0.726 (0.042) | 0.914 (0.048) |
| ENback Negative vs Neutral Face | NA (NA) | -0.011 (0.012) | 0.728 (0.041) | 0.914 (0.047) |
mental_health_performance_metric_baseline_kable <- mental_health_performance_metric_baseline%>%
kableExtra::kbl(caption = paste0("Performance metrics for mental health features, averaged across sites with SD in parentheses in baseline")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
mental_health_performance_metric_baseline_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Mental Health | 0.392 (0.068) | 0.153 (0.057) | 0.724 (0.027) | 0.918 (0.031) |
| CBCL | 0.273 (0.048) | 0.074 (0.028) | 0.758 (0.014) | 0.961 (0.015) |
| ASR | 0.214 (0.09) | 0.044 (0.046) | 0.77 (0.022) | 0.976 (0.024) |
| Child personality | 0.268 (0.057) | 0.072 (0.033) | 0.758 (0.019) | 0.962 (0.017) |
mental_health_performance_metric_followup_kable <- mental_health_performance_metric_followup%>%
kableExtra::kbl(caption = paste0("Performance metrics for mental health features, averaged across sites with SD in parentheses in followup")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
mental_health_performance_metric_followup_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Mental Health | 0.396 (0.079) | 0.141 (0.073) | 0.696 (0.047) | 0.88 (0.056) |
| CBCL | 0.241 (0.055) | 0.042 (0.034) | 0.736 (0.046) | 0.93 (0.054) |
| ASR | 0.211 (0.086) | 0.027 (0.049) | 0.74 (0.045) | 0.937 (0.055) |
| Child personality | 0.309 (0.074) | 0.081 (0.058) | 0.72 (0.048) | 0.91 (0.053) |
gene_performance_metric_baseline_kable <- gene_performance_metric_baseline%>%
kableExtra::kbl(caption = paste0("Performance metrics for genes, averaged across sites with SD in parentheses in baseline")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
gene_performance_metric_baseline_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Genes | 0.253 (0.056) | 0.02 (0.074) | 0.696 (0.055) | 0.884 (0.066) |
gene_performance_metric_followup_kable <- gene_performance_metric_followup%>%
kableExtra::kbl(caption = paste0("Performance metrics for genes, averaged across sites with SD in parentheses in followup")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
gene_performance_metric_followup_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Genes | 0.239 (0.09) | 0.024 (0.075) | 0.672 (0.056) | 0.853 (0.072) |
ses_performance_metric_baseline_kable <- ses_performance_metric_baseline%>%
kableExtra::kbl(caption = paste0("Performance metrics for Social Demo Lifestyle Dev, averaged across sites with SD in parentheses in baseline")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
ses_performance_metric_baseline_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Social Demo Lifestyle Dev | 0.486 (0.08) | 0.238 (0.083) | 0.687 (0.041) | 0.871 (0.049) |
ses_performance_metric_followup_kable <- ses_performance_metric_followup%>%
kableExtra::kbl(caption = paste0("Performance metrics for Social Demo Lifestyle Dev, averaged across sites with SD in parentheses in followup")) %>%
kableExtra::kable_classic(full_width = F,
html_font = "Cambria")
ses_performance_metric_followup_kable
| Features | Correlation | Traditional R-squared | MAE | RMSE |
|---|---|---|---|---|
| Social Demo Lifestyle Dev | 0.47 (0.091) | 0.218 (0.09) | 0.697 (0.043) | 0.881 (0.052) |
kableExtra::save_kable(brain_baseline_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/brain_baseline_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(brain_followup_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/brain_followup_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(mental_health_performance_metric_baseline_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/mental_health_performance_metric_baseline_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(mental_health_performance_metric_followup_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/mental_health_performance_metric_followup_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(gene_performance_metric_baseline_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/gene_performance_metric_baseline_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(gene_performance_metric_followup_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/gene_performance_metric_followup_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(ses_performance_metric_baseline_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/ses_performance_metric_baseline_kable', '.png'),keep_tex = FALSE)
kableExtra::save_kable(ses_performance_metric_followup_kable,file = paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/performance_metrics/ses_performance_metric_followup_kable', '.png'),keep_tex = FALSE)
psy_seperate_plot_baseline <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/scatter_plots/psy_seperate_plot_baseline', '.RData'))
psy_seperate_plot_followup <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/scatter_plots/psy_seperate_plot_followup', '.RData'))
scatter_legend <- readRDS(paste0(scriptfold,'Common_psy_gene_brain_all/saved_outputs/scatter_plots/scatter_legend', '.RData'))
names_vec <- c("Brain", "Mental Health", "Genes", "Social Demo Lifestyle Dev")
pred_names <- c("random_forest_stacking","psychopathology","gene_cog","ses" )
## create the labels
cor_label_vec_baseline <- c(brain_performance_metric_baseline$Correlation,
mental_health_performance_metric_baseline$Correlation[1],
gene_performance_metric_baseline$Correlation,
ses_performance_metric_baseline$Correlation)
cor_label_vec_followup <- c(brain_performance_metric_followup$Correlation,
mental_health_performance_metric_followup$Correlation[1],
gene_performance_metric_followup$Correlation,
ses_performance_metric_followup$Correlation)
scatter_plot_gfactor_new <- function(data_input,name_input,pred_names,cor_labels){
scatter_plot <- ggplot(data_input,aes(x = scale(.data[[pred_names]]) ,
y = scale(.data[["gfactor"]]))) +
geom_pointdensity(size = 1) +
scale_color_viridis()+
geom_smooth(method = 'lm', se = FALSE, col = 'black') +
labs(x = NULL,
y = NULL,
title = paste (name_input,'\nr = ',cor_labels))+
scale_x_continuous(limits=c(-5,5))+
scale_y_continuous(limits=c(-5,5))+
theme_classic() +
theme(axis.text.x = element_text(size = 35),
axis.text.y = element_text(size = 35),
plot.title = element_text(size=35)) +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none")
return(scatter_plot)
}
scatter_plot_baseline_new <- pmap(list(pred_gfactor_baseline,names_vec,pred_names,cor_label_vec_baseline),
~scatter_plot_gfactor_new(data_input = ..1,
name_input = ..2,
pred_names = ..3,
cor_labels = ..4))
scatter_plot_followup_new <- pmap(list(pred_gfactor_followup,names_vec,pred_names,cor_label_vec_followup),
~scatter_plot_gfactor_new(data_input = ..1,
name_input = ..2,
pred_names = ..3,
cor_labels = ..4))
### manually change the order of the plots
scatter_baseline_mental_health <- vector("list",length = 4)
scatter_baseline_mental_health[[1]] <- scatter_plot_baseline_new[[2]]
scatter_baseline_mental_health[[2]] <- psy_seperate_plot_baseline[[2]]
scatter_baseline_mental_health[[3]] <- psy_seperate_plot_baseline[[1]]
scatter_baseline_mental_health[[4]] <- psy_seperate_plot_baseline[[3]]
scatter_baseline_all<- vector("list",length = 3)
scatter_baseline_all[[1]] <- scatter_plot_baseline_new[[1]]
scatter_baseline_all[[2]] <- scatter_plot_baseline_new[[3]]
scatter_baseline_all[[3]] <- scatter_plot_baseline_new[[4]]
scatter_followup_mental_health <- vector("list",length = 4)
scatter_followup_mental_health[[1]] <- scatter_plot_followup_new[[2]]
scatter_followup_mental_health[[2]] <- psy_seperate_plot_followup[[2]]
scatter_followup_mental_health[[3]] <- psy_seperate_plot_followup[[1]]
scatter_followup_mental_health[[4]] <- psy_seperate_plot_followup[[3]]
scatter_followup_all <- vector("list",length = 3)
scatter_followup_all[[1]] <- scatter_plot_followup_new[[1]]
scatter_followup_all[[2]] <- scatter_plot_followup_new[[3]]
scatter_followup_all[[3]] <- scatter_plot_followup_new[[4]]
## plots with mental health
scatter_baseline_grid_mental_health <-ggpubr::ggarrange(plotlist = scatter_baseline_mental_health,
ncol = 4,nrow = 1) %>%
# legend.grob = scatter_legend,
# legend="top")%>%
ggpubr::annotate_figure(top = ggpubr::text_grob("Baseline",size=45,face="bold",hjust=3.4)) %>%
ggpubr::ggarrange( legend.grob = scatter_legend,
legend="top")
## Warning: Removed 2 rows containing non-finite values (`stat_pointdensity()`).
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 2 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 9 rows containing non-finite values (`stat_pointdensity()`).
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 9 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 2 rows containing non-finite values (`stat_pointdensity()`).
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 2 rows containing non-finite values (`stat_smooth()`).
## `geom_smooth()` using formula = 'y ~ x'
scatter_followup_grid_mental_health <-ggpubr::ggarrange(plotlist = scatter_followup_mental_health,
ncol = 4,nrow = 1)%>%
ggpubr::annotate_figure(top = ggpubr::text_grob("Followup",face="bold",size=45,hjust=3.2))
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 9 rows containing non-finite values (`stat_pointdensity()`).
## `geom_smooth()` using formula = 'y ~ x'
## Warning: Removed 9 rows containing non-finite values (`stat_smooth()`).
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
scatter_all_grid_mental_health <- ggpubr::ggarrange(scatter_baseline_grid_mental_health,scatter_followup_grid_mental_health,nrow = 2,heights = c(1.2,1))
labelled_scatter_mental_health <- ggpubr::annotate_figure(scatter_all_grid_mental_health,
left= ggpubr::text_grob("Observed Cognitive Abilities (Z)",size=45,rot=90),
bottom = ggpubr::text_grob("Predicted Cognitive Abilities (Z)",size=45),
top = ggpubr::text_grob("Performance of Mental Health in Predicting Cognitive Abilities",size=45, face = "bold"))
labelled_scatter_mental_health
## scatterplots with others
scatter_baseline_grid_all <-ggpubr::ggarrange(plotlist = scatter_baseline_all,
#common.legend = TRUE,
ncol = 3,nrow = 1
#,
# legend.grob = scatter_legend,
# legend="top"
)%>%
ggpubr::annotate_figure(top = ggpubr::text_grob("Baseline",face="bold",size=45,hjust=3.8))%>%
ggpubr::ggarrange(legend.grob = scatter_legend,
legend="top")
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
scatter_followup_grid_all <-ggpubr::ggarrange(plotlist = scatter_followup_all,
ncol = 3,nrow = 1)%>%
ggpubr::annotate_figure(top = ggpubr::text_grob("Followup",face="bold",size=45,hjust=3.55))
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
scatter_all_grid <- ggpubr::ggarrange(scatter_baseline_grid_all,scatter_followup_grid_all,nrow = 2,heights = c(1.2,1))
labelled_scatter_all <- ggpubr::annotate_figure(scatter_all_grid,
left= ggpubr::text_grob("Observed Cognitive Abilities (Z)",size=45,rot=90),
bottom = ggpubr::text_grob("Predicted Cognitive Abilities (Z)",size=45),
top = ggpubr::text_grob("Performance of the Brain, Genes and Social-Demographics, \nLifestyles and Developments in Predicting Cognitive Abilities",size=50, face = "bold"))
labelled_scatter_all